COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	!	esc_p,brk_n
C00004 00004	!	string comparison function 
C00005 00005	!	dat_str
C00007 00006	!	ugetf, uget
C00009 00007	!	file manipulation
C00017 00008	!	monitor
C00019 00009	!	integer to 11 fp conversion 
C00022 00010	!	date and time routines
C00023 00011	!	swap to E, then resume 
C00028 ENDMK
C⊗;
ENTRY;
BEGIN "UTILITY routines"

DEFINE ! = "COMMENT",
	α = "BEGIN",
	∨ = "END",
	FF = "'14",
	CRLF = "('15&'12)";

EXTERNAL PROCEDURE PRESWAP;
EXTERNAL PROCEDURE POSTSWAP;

EXTERNAL PROCEDURE ERROR(STRING S,S1(NULL));
!	esc_p,brk_n;

INTERNAL PROCEDURE ESC_P;
	BEGIN
	define ttyset = "'047000400121";
	  quick_code
	  hrroi 1,['004000000120]; comment [004000,,"P"];
	  ttyset 1,	;	        ! this last stuff does an esc-P;
	  end;
	END;



INTERNAL PROCEDURE BRK_N;
	BEGIN
	define ttyset = "'047000400121";
	  quick_code
	  hrroi 1,['004000000516]; comment [004000,,400+"N"];
	  ttyset 1,	;	        ! this last stuff does an BRK-N;
	  end;
	END;

!	string comparison function ;

	! compares two strings s1,s2.  If they are equal returns 0
	otherwise if s1 is alphabetically before s2 then
	returns -1 else returns 1 ;
INTERNAL SIMPLE INTEGER PROCEDURE COMPEQU(STRING S1,S2);
	BEGIN
	INTEGER I1,I2;
	IF EQU(S1,S2) THEN RETURN(0);
	DO I1←LOP(S1) UNTIL I1≠(I2←LOP(S2));
	IF I1>I2 THEN RETURN(-1) ELSE RETURN(1);
	END;
!	dat_str;

PRELOAD_WITH "Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sept","Oct","Nov","Dec";
STRING ARRAY $MONTH[0:11];

INTERNAL STRING PROCEDURE DAT_STR;
BEGIN
	INTEGER SDATE,SSEC; integer width,digits;
	INTEGER YEAR,MONTH,DATE,HOUR,MINUTE,SECOND;
	STRING  DATE_STRING;

	comment using ACCTIM UUO;

	quick_code;
		calli	'13,'400101;
		hlrzm	'13,SDATE;
		hrrzm	'13,SSEC;
	end;


	DATE←SDATE MOD 31;
	SDATE←SDATE DIV 31;
	MONTH←SDATE MOD 12;
	YEAR←(SDATE DIV 12) + 1964;

	SECOND←SSEC MOD 60;
	SSEC←SSEC DIV 60;
	MINUTE←SSEC MOD 60;
	HOUR←SSEC DIV 60;

	GETFORMAT(WIDTH,DIGITS);
	SETFORMAT(0,0);
	DATE_STRING←CVS(HOUR)&":";
	SETFORMAT(-2,0);
	DATE_STRING←DATE_STRING&CVS(MINUTE)&"  ";
	SETFORMAT(0,0);
	DATE_STRING←DATE_STRING&CVS(DATE+1)&" "&$MONTH[MONTH]&" "&CVS(YEAR);
	SETFORMAT(WIDTH,DIGITS);
	RETURN(DATE_STRING);
END;
!	ugetf, uget;


INTERNAL INTEGER PROCEDURE UGETF(INTEGER CHAN);
BEGIN	! positions the pointer to the last record in the file ;
	define UGETF = '073000;
	INTEGER I,CHN; LABEL DOUGTF;
	CHN←CHAN;
	quick_code;
		move	'13,CHN;
		lsh	'13,5;
		addi	'13,UGETF;
		hrlm	'13,DOUGTF;	! PREPARE UGETF;
	DOUGTF:
		I			;
	end;
	RETURN(I);
END;


INTERNAL INTEGER PROCEDURE UGET(INTEGER CHAN);
BEGIN	! gets the record number of the current place in the file ;
	define MTAPE = '072000;
	LABEL ADR,ADR1,DOMTPE; INTEGER CHN;
	INTEGER GMOD; GMOD←CVSIX("GODMOD");
	CHN←CHAN;
	quick_code;
		move	'13,GMOD;
		movem	'13,ADR;
		setzm	'13,adr1;
		move	'13,CHN;
		lsh	'13,5;
		addi	'13,MTAPE;
		hrlm	'13,DOMTPE;
		jrst	DOMTPE	;
	ADR:
		0	;	! '475744555744; ! SIXBIT /GODMOD/;
	ADR1:	0	;
	DOMTPE:
		ADR		;
		move	'13,ADR1;
		movem	'13,CHN;
	end;
	RETURN(CHN);
END;
!	file manipulation;

INTERNAL STRING PROCEDURE FILENAME(INTEGER CHAN);
BEGIN	! given the i/o channel chan, this procedure returns full form of the
	file name ;
	STRING S,S1;
	EXTERNAL INTEGER JOBJDA;
	INTEGER DDB_ADDR;
	INTEGER SPBREAK,I;
	CALL(0,"SLEEP");
	DDB_ADDR←MEMORY[LOCATION(JOBJDA)+CHAN] LAND '777777 ;
	DEFINE DEVFIL='11,DEVEXT='12,FILPPN='14;
	S←CVXSTR(CALL(DDB_ADDR+DEVFIL,"PEEK"))&"."&
		CVXSTR(CALL(DDB_ADDR+DEVEXT,"PEEK"))[1 FOR 3]&
		"["&CVXSTR(CALL(DDB_ADDR+FILPPN,"PEEK"))[1 TO 3]&","&
			CVXSTR(CALL(DDB_ADDR+FILPPN,"PEEK"))[4 TO 6]&"]";
	SETBREAK(SPBREAK←GETBREAK,NULL," ","I");
	S1←SCAN(S,SPBREAK,I);
	RELBREAK(SPBREAK);
	RETURN(S1);
END;

INTERNAL PROCEDURE UDATEFILE(INTEGER CHAN);
BEGIN	! writes out the current file and reopens it
	again at the end of the last page ;
	INTEGER FLAG; INTEGER I; STRING S;
	I←UGET(CHAN);	CLOSE(CHAN);
	S←FILENAME(CHAN);
	LOOKUP(CHAN,S,FLAG);
	ENTER(CHAN,S,FLAG);
	USETI(CHAN,I);	S←NULL;
	DO S←S&INPUT(CHAN,0) UNTIL GETSTS(CHAN) LAND '20000;
					 ! read til end of file;
	USETO(CHAN,I);	OUT(CHAN,S);
END;


INTERNAL INTEGER PROCEDURE OREADFILE(STRING FILE;REFERENCE INTEGER EOF);
BEGIN
	INTEGER CHAN,BRCHAR,FLAG;
	OPEN(CHAN←GETCHAN,"DSK",0,10,0,1000,BRCHAR,EOF);
	LOOKUP(CHAN,FILE,FLAG);
	IF NOT FLAG THEN RETURN(CHAN); ! success ;
		RELEASE(CHAN);
		CASE FLAG LAND '777777 OF
			BEGIN
			[0] ERROR(FILE&" is nonexistent");
			[1] ERROR(FILE&" has illegal PPN");
			[2] ERROR(FILE&" protection violation");
			[3] ERROR(FILE&" is busy");
			ELSE ERROR(FILE&": unknown error in opening file")
			END;
END;

INTERNAL STRING PROCEDURE READFILE(STRING FILE);
BEGIN
	INTEGER CHAN,EOF,FFBREAK;
	STRING MSSGE;
	CHAN←OREADFILE(FILE,EOF);
	SETBREAK(FFBREAK←GETBREAK,FF,NULL,"ISN");
	MSSGE←NULL;
	WHILE NOT EOF DO MSSGE←MSSGE&" "&INPUT(CHAN,FFBREAK);
	RELEASE(CHAN);
	RELBREAK(FFBREAK);
	RETURN(MSSGE);
END;

INTERNAL PROCEDURE WRITEFILE(STRING FILE,MSSGE);
BEGIN	! this will destroy existing file ;
	INTEGER CHAN,BRCHAR,EOF,FLAG;
	OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
	ENTER(CHAN,FILE,FLAG);
	IF FLAG THEN
		BEGIN
		RELEASE(CHAN);
		CASE FLAG LAND '777777 OF
			BEGIN
			[0] ERROR("NULL filename given");
			[1] ERROR(FILE&": illegal PPN");
			[2] ERROR(FILE&" protection violation");
			[3] ERROR(FILE&" is currently busy");
			['12] ERROR("DISK is full...groan...");
			ELSE ERROR(FILE&": unknown file error, code ="&
				CVOS(FLAG LAND '777777))
			END;
		END;
	OUT(CHAN,MSSGE);
	CLOSE(CHAN);
	RELEASE(CHAN);
END;

PROCEDURE DELETEFILE(STRING FILE);
BEGIN
	INTEGER CHAN,BRCHAR,EOF,FLAG;
	OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
	ENTER(CHAN,FILE,FLAG);
	RENAME(CHAN,NULL,0,FLAG);
	CLOSE(CHAN);
	RELEASE(CHAN);
END;

INTERNAL INTEGER PROCEDURE OWRITEFILE(STRING FILE);
BEGIN
	INTEGER CHAN,BRCHAR,EOF,FLAG;
	OPEN(CHAN←GETCHAN,"DSK",0,0,19,1000,BRCHAR,EOF);
	ENTER(CHAN,FILE,FLAG);
	RETURN(CHAN);
END;

BOOLEAN PROCEDURE FILE_ABSENT(STRING FNAME);
BEGIN "check if FNAME exists"
	INTEGER INPCH,BRCHR,EOF;
	BOOLEAN E;
	OPEN(INPCH←GETCHAN,"DSK",0,3,0,1000,BRCHR,EOF);
	LOOKUP(INPCH,FNAME,EOF);
	E←EOF LAND '777777000000;
	RELEASE(INPCH);
	RETURN(E);
END;


INTERNAL INTEGER PROCEDURE ORAFILE(STRING FILE,S(NULL));
BEGIN
	INTEGER CHAN,BRCHAR,EOF,FLAG;
	IF FILE_ABSENT(FILE) THEN
	    BEGIN
		CHAN←OWRITEFILE(FILE);
		CLOSE(CHAN);
		RELEASE(CHAN);
		IF S=FF THEN S←S[2 TO ∞]; ! if begins with formfeed then can lop it off;
	    END;
	! writes out the string s into file FILE:
	if the first character is a formfeed then start on a new page.;
	OPEN(CHAN←GETCHAN,"DSK",0,19,19,1000,BRCHAR,EOF);
	LOOKUP(CHAN,FILE,FLAG);
	ENTER(CHAN,FILE,FLAG);
	IF FLAG THEN
		BEGIN RELEASE(CHAN);
		CASE FLAG LAND '777777 OF
			BEGIN
			[0] ERROR(FILE&" is nonexistent");
			[1] ERROR(FILE&" illegal PPN");
			[2] ERROR(FILE&" protection violation");
			[3] ERROR(FILE&" is busy");
			['12] ERROR("DISK is full.. groan..");
			ELSE ERROR(FILE&" error code = "&CVOS(FLAG LAND '777777))
			END;
		END;
	IF S=FF THEN UGETF(CHAN)
		ELSE BEGIN
			INTEGER I; STRING S1;
			DO INPUT(CHAN,0) UNTIL EOF;
			I←UGET(CHAN);
			USETI(CHAN,I);
			S1←NULL;
			DO S1←S1&INPUT(CHAN,0) UNTIL EOF;
			USETO(CHAN,I);
			OUT(CHAN,S1);
		     END;
	OUT(CHAN,S);
	RETURN(CHAN);
	END;

INTERNAL PROCEDURE CRAFILE(INTEGER CHAN);
	BEGIN
	CLOSE(CHAN);
	RELEASE(CHAN);
	END;

INTERNAL PROCEDURE ADDFILE(STRING FILE,S);
BEGIN	! adds string S to a file FILE, which if does not exist is created
	and then updates the file;
	INTEGER CHAN;
	CHAN←ORAFILE(FILE,S);
	CRAFILE(CHAN);
END;
!	monitor;

INTERNAL SIMPLE INTEGER PROCEDURE LOGIN(STRING PPN(NULL));
	BEGIN
	STRING S;
	external integer _skip_;
	INTEGER PTYLINE;
	DO ptyline←ptyget UNTIL _skip_;
	IF PPN≠NULL THEN S←PPN ELSE
		BEGIN
		STRING S1,S2;
		S1←CVXSTR(CALL(0,"DSKPPN"))[1 TO 3];
		S2←CVXSTR(CALL(0,"DSKPPN"))[4 TO 6];
		WHILE S1=" " DO S1←S1[2 TO ∞];
		WHILE S2=" " DO S2←S2[2 TO ∞];
		S←S1&"."&S2;
		END;
	ptostr(PTYLINE,"L "&S&CRLF);
	S←PTYSTR(PTYLINE,"↑");
	S←PTYSTR(PTYLINE,".");
	RETURN(PTYLINE);
	END;

PROCEDURE MONCOM(INTEGER PTYLINE; STRING COMMAND);
	BEGIN
	STRING S;
	PTOSTR(PTYLINE,COMMAND&CRLF);
	S←PTYSTR(PTYLINE,"↑");
	S←PTYSTR(PTYLINE,".");
	END;

INTERNAL PROCEDURE LOGOUT(INTEGER PTYLINE);
	PTYREL(PTYLINE);

INTERNAL PROCEDURE MONITOR(STRING COMMAND,PPN(NULL));
	BEGIN
	INTEGER PTY;
	PTY←LOGIN(PPN);
	MONCOM(PTY,COMMAND);
	LOGOUT(PTY);
	END;

!	integer to 11 fp conversion ;

! PROCEDURE FOR CONVERTING A FLOATING POINT NUMBER IN 11 FORMAT ;
!	plagiarized from BES in move.sai;

INTERNAL PROCEDURE FLTOUT(REAL FNUM; REFERENCE INTEGER XNUM1,XNUM2);
	BEGIN
	LABEL ST1,ST2,OVER,FLTEND;
	INTEGER BYTE,NUM1,NUM2;
	BYTE←'013200000002;
		START_CODE
		   	MOVE   2,FNUM;
			JUMPGE 2,ST1;
			MOVN   2,2;
 			TLO    2,'400000;
		ST1:	JFCL   2,ST2;
		ST2:	ADDI   2,4;
			JFCL   2,OVER;
     		    	DPB    2,BYTE;
			SETZ   1,;
			LSHC   1,16;
			MOVEM  1,NUM1;
			SETZ   1,;
			LSHC   1,16;
			MOVEM  1,NUM2;
		END;
	XNUM1←NUM1;
	XNUM2←NUM2;
	GOTO FLTEND;
OVER:	OUTSTR("ERROR-ROUNDING OVERFLOW"&CRLF);
FLTEND:	END; 


INTERNAL REAL PROCEDURE RFVAL(INTEGER WORD1,WORD2);
 BEGIN
 ! This procedure gives the real floating point value of a floating point number
  in WORD1 and WORD2 with F format of pdp-11.;
 REAL X;
 INTEGER SIGN,EXPONENT,FRACTION;
! PRINT(CRLF,"WORD1=",CVOS(WORD1),"    WORD2=",CVOS(WORD2));
 SIGN← WORD1 LSH -15;
 EXPONENT← (WORD1 LSH 21) LSH -28 ;
 FRACTION← (((WORD1 LAND '177) LOR (IF EXPONENT THEN '200 ELSE 0)) LSH 16) LOR WORD2 ;
 IF SIGN=1 THEN BEGIN EXPONENT← LNOT EXPONENT; FRACTION← '100000000 - FRACTION; END;
! PRINT(CRLF,"SIGN=",SIGN,"  EXPONENT=",CVOS(EXPONENT),"   FRACTION=",CVOS(FRACTION));
 MEMORY[LOCATION(X),INTEGER]← SIGN LSH 35 LOR EXPONENT LSH 27 LOR FRACTION LSH 3 ;
! PRINT(CRLF,CVOS(X));
 RETURN(X);
 END;

!	date and time routines;

! total runtime since login in msecs;
INTERNAL SIMPLE INTEGER PROCEDURE RUNTIM;
	RETURN(CALL(0,"RUNTIM"));

! number of days since Jan 1, 1964;
INTERNAL SIMPLE INTEGER PROCEDURE DAYCNT;
	RETURN(CALL(0,"DAYCNT"));

! number of msecs after midnight;
INTERNAL SIMPLE INTEGER PROCEDURE MSTIME;
	RETURN(CALL(0,"MSTIME"));
!	swap to E, then resume ;
INTERNAL PROCEDURE SWAP(REFERENCE STRING MODIFY_STRING);
BEGIN
! this procedure will save the current state of the POINTY program in
the file PONTY2.DMP[PNT,HE], and swap to E to a file called E$TEMP.TMP[PNT,HE]
which it writes with the contents of MODIFY_STRING,
and allows the user to modify.  When the user exits E
by doing <control>XRUN, the POINTY program resumes by swapping back
PONTY2.DMP[PNT,HE] and renaming it POINTY, and then reading in E$TEMP.TMP[PNT,HE]
as the input string MODIFY_STRING;
EXTERNAL INTEGER JOBSA;
INTEGER ARRAY ACS[0:15];	! temporary storage for accumulators;
INTEGER ARRAY EARRAY[0:'17];
INTEGER EA0,EA15;
INTEGER AACS0,AACS15,AACS14;	! address of ACS[0],ACS[15],ACS[14];
LABEL RESUME;
INTEGER ARRAY SAVADR[0:4],GETADR[0:5];

STRING COREIMAGEFILE,E$TEMP;

	E$TEMP←"E$TEMP.TMP[PNT,HE]";
	WRITEFILE(E$TEMP,MODIFY_STRING);
	COREIMAGEFILE←"XXXXXX.DMP";
	AACS0←LOCATION(ACS[0]);
	AACS15←LOCATION(ACS[15]);
	AACS14←LOCATION(ACS[14]);

	SAVADR[0]←CVSIX("DSK");
	SAVADR[1]←CVFIL(COREIMAGEFILE,SAVADR[2],SAVADR[4]);
!	SAVADR[2]←SAVADR[2] LOR 1 used for saving high seg ;
!	SAVADR[3]←LOCATION(RESUME);

	GETADR[0]←CVSIX("SYS");
	GETADR[1]←CVFIL("E.DMP[1,3]",GETADR[2],GETADR[4]);   ! ? ;
!	GETADR[2]←GETADR[2] LOR 4;
	GETADR[3]←1;
	GETADR[5]←CALL(0,"DSKPPN");	! use current dsk ppn;

	ARRCLR(EARRAY);
	EARRAY[0]←CVFIL(COREIMAGEFILE,EARRAY[1],EARRAY[3]);
	EARRAY[6]←CVSIX("DSK");
	EARRAY['14]←CVFIL(E$TEMP,EARRAY['13],EARRAY['11]);
	EARRAY['12]←CVSIX("DSK");
	EARRAY['13]←EARRAY['13] LOR '100000; 	! /N mode ;
	EARRAY['15]←1;	! line no = 1;
	EARRAY['16]←1;	! page no = 1;
	EARRAY['17]←(LOCATION(SAVADR[0]) LSH 18) LOR LOCATION(GETADR[0]);
	EA0←LOCATION(EARRAY[0]);

BRK_N;
PRINT("I am swapping to the Editor; when you are done with the Editor, type
<control>XRUN to resume. If you get out of E by typing <control>E, get
back into E by typing CONT and resume by typing <control>XRUN.
If you lose your core image, you can resume by doing a RU "&COREIMAGEFILE&"
");
PRESWAP;
	quick_code
		MOVEM	15,@AACS15;	COMMENT SAVE ACCUMS ;
		MOVE	15,AACS0;
		BLT	15,@AACS14;
		MOVEI	1,RESUME;
		MOVEM	1,JOBSA;
		MOVS	15,EA0;		! get address of state of E call ;
		BLT	15,15;		! set up accumulator calls for E;
		CALLI	15,'400004;	! swap to E ;
	RESUME:	JFCL	;		! no-op;
		JFCL	;		! restore accumulators;
		MOVS	15,AACS0; ! get address of AC[0];
		BLT	15,15;	  ! BLT into memory;
	end;
POSTSWAP;
CALL(CVSIX("POINTY"),"SETNAM");
DELETEFILE(COREIMAGEFILE);
MODIFY_STRING←READFILE(E$TEMP);
DELETEFILE(E$TEMP);
END;

END "UTILITY routines";